home *** CD-ROM | disk | FTP | other *** search
/ Die Ultimative Software-P…i Collection 1996 & 1997 / Die Ultimative Software-Pakete CD-ROM fur Atari Collection 1996 & 1997.iso / s / s_color1 / solit / solit.gfa (.txt) next >
Encoding:
GFA-BASIC Atari  |  1996-09-18  |  7.4 KB  |  321 lines
  1. ' #############################################################################
  2. ' #                         æ  M O T E L S O F T  æ                           #
  3. ' #############################################################################
  4. '
  5. ' -----------------------------------------------------------------------------
  6. ' Arbeitstitel                > S O L I T  <
  7. ' -----------------------------------------------------------------------------
  8. '           CO.HARALD BREITMAIER  MARKUSPLATZ 3  7000 STUTTGART 1
  9. '                             TEL. 0711~640 22 87
  10. ' #############################################################################
  11. ' ----------> DATUM <------------           ---------->VERSION  1.0 <---------
  12. SETTIME "","02.07.88"
  13. ' #############################################################################
  14. ON ERROR GOSUB gfa1
  15. ON BREAK CONT
  16. SETCOLOR 0,0
  17. SETCOLOR 15,7,7,7
  18. '
  19. '
  20. '
  21. DIM feld%(10,10)
  22. DIM bil$(6)
  23. ' -------------------------
  24. GOSUB bilo("TITEL")
  25. BMOVE V:screen$,XBIOS(3),32000
  26. ' -------------------------
  27. GOSUB bilo("SOLIT1")
  28. ' -------------------------
  29. REPEAT
  30. UNTIL MOUSEK
  31. '
  32. BMOVE V:screen$,XBIOS(3),32000
  33. x%=0
  34. y%=0
  35. GET x%*16,y%*16,(x%*16)+16,(y%*16)+16,bil$(2)
  36. x%=5
  37. y%=1
  38. GET x%*16,y%*16,(x%*16)+16,(y%*16)+16,bil$(3)
  39. x%=1
  40. y%=0
  41. GET x%*16,y%*16,(x%*16)+16,(y%*16)+16,bil$(4)
  42. GET 2,145,47,173,ret$
  43. GOSUB mach_es
  44. '
  45. > PROCEDURE mach_es
  46.   ' -----
  47. start:
  48.   ' -----
  49.   IF score%>high%
  50.     high%=score%
  51.   ENDIF
  52.   '
  53.   score%=0
  54.   GOSUB feld
  55.   ox%=190
  56.   oy%=0
  57.   alle%=0
  58.   ' -----
  59.   DO
  60.     ' -----
  61.   rein1:
  62.     r%=1
  63.     GOSUB maus(16,16,0,10,0,10)
  64.     sx%=x%
  65.     sy%=y%
  66.     was%=feld%(sx%,sy%)
  67.     ' -----
  68.     EXIT IF was%=3 OR was%=4
  69.     ' -----
  70.     IF was%<>2
  71.       GOTO rein1
  72.     ENDIF
  73.     COLOR 1
  74.     GET sx%*16,sy%*16,(sx%*16)+16,(sy%*16)+16,bil$(1)
  75.     BOX sx%*16,sy%*16,(sx%*16)+16,(sy%*16)+16
  76.     ssx%=sx%*16
  77.     ssy%=sy%*16
  78.     ' -------------------------
  79.   rein2:
  80.     r%=2
  81.     GOSUB maus(16,16,0,10,0,10)
  82.     nx%=x%
  83.     ny%=y%
  84.     ' -----
  85.     IF k%=2
  86.       PUT ssx%,ssy%,bil$(3)
  87.       GOTO rein1
  88.     ENDIF
  89.     ' -----
  90.     was%=feld%(nx%,ny%)
  91.     EXIT IF was%=3 OR was%=4
  92.     ' -----
  93.     IF was%<>0
  94.       GOSUB sou3
  95.       GOTO rein2
  96.     ENDIF
  97.     ' -----
  98.     IF ny%=sy%-1 OR ny%=sy%+1
  99.       GOSUB sou3
  100.       GOTO rein2
  101.     ENDIF
  102.     ' -----
  103.     IF nx%=sx%-1 OR nx%=sx%+1
  104.       GOSUB sou3
  105.       GOTO rein2
  106.     ENDIF
  107.     ' -----
  108.     IF ny%<sy%-2 OR ny%>sy%+2
  109.       GOSUB sou3
  110.       GOTO rein2
  111.     ENDIF
  112.     IF nx%>sx%+2 OR nx%<sx%-2
  113.       GOSUB sou3
  114.       GOTO rein2
  115.     ENDIF
  116.     ' --------------------------------------------------------
  117.     IF ny%=sy% AND nx%=sx%-2
  118.       what%=feld%(sx%-1,ny%)
  119.       wegx%=sx%-1
  120.       wegy%=sy%
  121.       GOTO weiter
  122.     ENDIF
  123.     ' -----
  124.     IF ny%=sy% AND nx%=sx%+2
  125.       what%=feld%(sx%+1,ny%)
  126.       wegx%=sx%+1
  127.       wegy%=sy%
  128.       GOTO weiter
  129.     ENDIF
  130.     ' -----
  131.     IF nx%=sx% AND ny%=sy%-2
  132.       what%=feld%(sx%,ny%+1)
  133.       wegx%=sx%
  134.       wegy%=sy%-1
  135.       GOTO weiter
  136.     ENDIF
  137.     ' -----
  138.     IF nx%=sx% AND ny%=sy%+2
  139.       what%=feld%(sx%,ny%-1)
  140.       wegx%=sx%
  141.       wegy%=sy%+1
  142.       GOTO weiter
  143.     ENDIF
  144.     GOTO rein2
  145.   weiter:
  146.     '  PRINT AT(1,1);sx%;" ";wegx%;" ";nx%;"<>";sy%;" ";wegy%;" ";ny%;" "
  147.     '  PRINT AT(1,3);what%;" "
  148.     ' -------------------------
  149.     IF what%<>2     !KEIN STEIN DAZWISCHEN
  150.       GOSUB sou3
  151.       GOTO rein2
  152.     ENDIF
  153.     ' -----
  154.     PUT wegx%*16,wegy%*16,bil$(2)
  155.     PUT sx%*16,sy%*16,bil$(2)
  156.     PUT nx%*16,ny%*16,bil$(3)
  157.     feld%(wegx%,wegy%)=0
  158.     feld%(sx%,sy%)=0
  159.     feld%(nx%,ny%)=2
  160.     INC alle%
  161.     PUT ox%,oy%,bil$(3)
  162.     ADD ox%,16
  163.     IF ox%>=318
  164.       ox%=190
  165.       ADD oy%,16
  166.     ENDIF
  167.     GOSUB sou2
  168.   LOOP
  169.   ' -------------------------
  170.   PUT 232,135,ret$
  171.   tot%=8
  172.   FOR i%=0 TO 10
  173.     FOR ii%=0 TO 10
  174.       q1%=feld%(i%,ii%)
  175.       ' -----
  176.       IF q1%=0
  177.         PUT i%*16,ii%*16,bil$(4)
  178.         GOSUB sou2
  179.         INC tot%
  180.         toty%=tot% DIV 8
  181.         ADD score%,10*toty%
  182.         IF high%<score%
  183.           high%=score%
  184.         ENDIF
  185.         PRINT AT(28,23);score%;"<>";high%
  186.       ENDIF
  187.       ' -----
  188.     NEXT ii%
  189.   NEXT i%
  190.   PAUSE 20
  191.   REPEAT
  192.   UNTIL MOUSEK
  193.   BMOVE V:screen$,XBIOS(3),32000
  194.   GOTO start
  195.   '
  196. RETURN
  197. ' --------------------------
  198. > PROCEDURE maus(sc1%,sc2%,sc3%,sc4%,sc5%,sc6%)
  199.   ' teiler x, teiler y,bereich <x >x bereich <y >y
  200.   '
  201.   PAUSE 20
  202.   SHOWM
  203.   '
  204. mausin:
  205.   REPEAT
  206.     MOUSE x%,y%,k%
  207.     x%=x% DIV sc1%
  208.     y%=y% DIV sc2%
  209.     '
  210.     '    PRINT AT(1,3);x%;" ";y%;"  ";
  211.     '    IF x%<11 AND y%<11
  212.     '      PRINT AT(1,2);feld%(x%,y%);"   ";r%;"  "
  213.     '  ENDIF
  214.     '
  215.   UNTIL k%
  216.   IF x%<sc3% OR x%>sc4%
  217.     GOTO mausin
  218.   ENDIF
  219.   IF y%<sc5% OR y%>sc6%
  220.     GOTO mausin
  221.   ENDIF
  222.   '
  223. mausex:
  224.   '
  225. RETURN
  226. ' -------------------------
  227. > PROCEDURE feld
  228.   RESTORE feld
  229.   FOR i%=0 TO 10
  230.     FOR ii%=0 TO 10
  231.       READ was%
  232.       feld%(ii%,i%)=was%
  233.     NEXT ii%
  234.   NEXT i%
  235.   '
  236. feld:
  237.   DATA 1,1,1,1,1,1,1,1,1,1,1
  238.   DATA 1,1,1,1,2,2,2,1,1,1,1
  239.   DATA 1,1,1,1,2,2,2,1,1,1,1
  240.   DATA 1,1,1,1,2,2,2,1,1,1,1
  241.   DATA 1,2,2,2,2,2,2,2,2,2,1
  242.   DATA 1,2,2,2,2,0,2,2,2,2,1
  243.   DATA 1,2,2,2,2,2,2,2,2,2,1
  244.   DATA 1,1,1,1,2,2,2,1,1,1,1
  245.   DATA 1,1,1,1,2,2,2,1,1,1,1
  246.   DATA 3,3,3,1,2,2,2,1,4,4,4
  247.   DATA 3,3,3,1,1,1,1,1,4,4,4
  248. RETURN
  249. ' -------------------------
  250. > PROCEDURE bilo(fil$)          !Degasbild laden
  251.   screen$=SPACE$(32000)
  252.   CLOSE #1
  253.   OPEN "i",#1,"A:\SOLIT\ART\"+fil$+".PI1"
  254.   farb$=SPACE$(34)                  !originalfarben des bildes laden
  255.   BGET #1,VARPTR(farb$),34          !und in string farb$ ablegen
  256.   '  Z%=0
  257.   FOR i%=3 TO LEN(farb$) STEP 2     !jeweils 2 werte ergeben die farbe
  258.     farb1$=MID$(farb$,i%)             !wert 1
  259.     farb2$=MID$(farb$,i%+1)           !wert 2
  260.     a%=ASC(farb1$)                    !ascii code
  261.     b%=ASC(farb2$)                    !asci code
  262.     c%=a%*256+b%                      !wandeln in farbcode
  263.     SETCOLOR z%,c%                    !in die farbregister damit
  264.     INC z%                            !hilfszahler
  265.   NEXT i%
  266.   BGET #1,V:screen$,32000            !bild laden
  267.   CLOSE #1
  268. RETURN
  269. ' -------------------------
  270. > PROCEDURE sou1
  271.   SOUND 1,15,4,6
  272.   PAUSE 10
  273.   SOUND 1,0,0,0,0
  274. RETURN
  275. ' -------------------------
  276. > PROCEDURE sou2
  277.   FOR t%=15 DOWNTO 0
  278.     SOUND 1,t%,5,1
  279.     SOUND 2,t%,12,2
  280.     SOUND 3,t%,5,4
  281.     WAVE 7
  282.     FOR d%=0 TO 1000
  283.     NEXT d%
  284.     SOUND 3,t%,5,5
  285.     FOR d%=0 TO 1000
  286.     NEXT d%
  287.   NEXT t%
  288. RETURN
  289. ' -------------------------
  290. > PROCEDURE sou3
  291.   SOUND 1,15,2,3
  292.   PAUSE 10
  293.   SOUND 1,0,0,0,0
  294. RETURN
  295. ' -------------------------
  296. > PROCEDURE gfa1
  297. scheisse:
  298.   GOTO scheisse
  299.   '
  300.   SETCOLOR 0,7,7,7
  301.   SETCOLOR 15,0
  302.   CLS
  303.   PRINT AT(1,1);"EIN FEHLER IST AUFGETRETEN"
  304.   PRINT AT(1,2);ERR$(ERR)
  305.   '
  306.   VOID INP(2)
  307.   EDIT
  308. RETURN
  309. ' ----------------------
  310. > PROCEDURE gfa2
  311.   SETCOLOR 0,7,7,7
  312.   SETCOLOR 15,0
  313.   CLS
  314.   PRINT AT(1,1);"STOP DURCH BREAK"
  315.   PRINT "FREE BYTES ";FRE(9)
  316.   '
  317.   VOID INP(2)
  318.   EDIT
  319. RETURN
  320. ' ----------------------
  321.